unit uAppInstanceApplication;

interface
uses
  uAppInstanceInterfaces;

type

  TAppInstanceApplication = class(TInterfacedObject, IApplication)
  private
    function CurrentVersionAsString(AppName: String): String;
    function CurrentVersion(AppName: String = ''): TApplicationVersion;
    function GetVersionFromString(const AValue: String): TApplicationVersion;
  public
    procedure AfterConstruction; override;
  end;

implementation

uses
  Forms, Controls, Types, SysUtils, Windows;

{TAppInstanceCursor}
procedure TAppInstanceApplication.AfterConstruction;
begin
  inherited;
end;

function TAppInstanceApplication.CurrentVersion(AppName: String): TApplicationVersion;
begin
  Result:=GetVersionFromString(CurrentVersionAsString(AppName));
end;

function TAppInstanceApplication.CurrentVersionAsString(AppName: String): String;
type
  PDWORD = ^DWORD;
  PLangAndCodePage = ^TLangAndCodePage;
  TLangAndCodePage = packed record
    wLanguage: WORD;
    wCodePage: WORD;
  end;
  PLangAndCodePageArray = ^TLangAndCodePageArray;
  TLangAndCodePageArray = array[0..0] of TLangAndCodePage;
var
  loc_InfoBufSize: DWORD;
  loc_InfoBuf: PChar;
  loc_VerBufSize: DWORD;
  loc_VerBuf: PChar;
  cbTranslate: DWORD;
  lpTranslate: PDWORD;
  i: DWORD;
begin
  Result := '';
  if AppName = '' then
  begin
    if (Length(ParamStr(0)) = 0) or (not Fileexists(ParamStr(0))) then
      Exit;
    loc_InfoBufSize := GetFileVersionInfoSize(PChar(ParamStr(0)), loc_InfoBufSize);
  end else
  begin
    if (Length(AppName) = 0) or (not Fileexists(AppName)) then
      Exit;
    loc_InfoBufSize := GetFileVersionInfoSize(PChar(AppName), loc_InfoBufSize);
  end;
  if loc_InfoBufSize > 0 then
  begin
    loc_VerBuf := nil;
    loc_InfoBuf := AllocMem(loc_InfoBufSize);
    try
      if not GetFileVersionInfo(PChar(ParamStr(0)), 0, loc_InfoBufSize, loc_InfoBuf)
        then
        exit;
      if not VerQueryValue(loc_InfoBuf, '\\VarFileInfo\\Translation',
        Pointer(lpTranslate), DWORD(cbTranslate)) then
        exit;
      for i := 0 to (cbTranslate div SizeOf(TLangAndCodePage)) - 1 do
      begin
        if VerQueryValue(
          loc_InfoBuf,
          PChar(Format(
          'StringFileInfo\0%x0%x\FileVersion', [
          PLangAndCodePageArray(lpTranslate)[i].wLanguage,
            PLangAndCodePageArray(lpTranslate)[i].wCodePage])),
            Pointer(loc_VerBuf),
          DWORD(loc_VerBufSize)
          ) then
        begin
          Result := loc_VerBuf;
          Break;
        end;
      end;
    finally
      FreeMem(loc_InfoBuf, loc_InfoBufSize);
    end;
  end;
end;


function TAppInstanceApplication.GetVersionFromString(
  const AValue: String): TApplicationVersion;
var S, tmpS:String;
    I:Integer;
    ACount:Integer;
begin
  S:=AValue+'.';
  ACount := 0;
  tmpS:='';
  for I := 1 to Length(S) do
  begin
    if S[i]='.' then
    begin
      case ACount of
        0:   Result.V1:=StrToIntDef(tmpS,0);
        1:   Result.V2:=StrToIntDef(tmpS,0);
        2:   Result.V3:=StrToIntDef(tmpS,0);
        3:   Result.V4:=StrToIntDef(tmpS,0);
      end;
      tmpS:='';
      Inc(ACount);
      continue;
    end;
    tmpS:=tmpS+S[i];
  end;
end;

end.
